home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / skk / skk-server.el.z / skk-server.el
Encoding:
Text File  |  1998-05-21  |  15.8 KB  |  370 lines
  1. ;;; skk-server.el --- SKK $B%5!<%P!<$N$?$a$N%W%m%0%i%`(B
  2. ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
  3. ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  4.  
  5. ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  6. ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
  7. ;; Version: $Id: skk-server.el,v 1.2 1997/08/24 15:25:57 mrt Exp $
  8. ;; Keywords: japanese
  9. ;; Last Modified: $Date: 1997/08/24 15:25:57 $
  10.  
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either versions 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with SKK, see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  24. ;; MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27. ;; Following people contributed modifications to skk-server.el (Alphabetical
  28. ;; order):
  29. ;;
  30. ;;      Hitoshi SUZUKI <h-suzuki@ael.fujitsu.co.jp>
  31. ;;      Hideki Sakurada <sakurada@kuis.kyoto-u.ac.jp>
  32. ;;      Kenji Rikitake <kenji@reseau.toyonaka.osaka.jp>
  33. ;;      Kiyotaka Sakai <ksakai@netwk.ntt-at.co.jp>
  34. ;;      Mikio Nakajima <minakaji@osaka.email.ne.jp>
  35. ;;      TOKUYA Junichi <tokuya@crab.fuji-ric.co.jp>
  36.  
  37. ;;; Change log:
  38.  
  39.  
  40. ;;; Code:
  41. (require 'skk-foreword)
  42. (require 'skk-vars)
  43.  
  44. ;; user variables.
  45. ;;;###skk-autoload
  46. (defvar skk-server-host (getenv "SKKSERVER")
  47.   "*SKK $B<-=q%5!<%P!<$rAv$i$;$F$$$k%[%9%HL>!#(B" )
  48.  
  49. ;;;###skk-autoload
  50. (defvar skk-server-prog (getenv "SKKSERV")
  51.   "*SKK $B<-=q%5!<%P!<%W%m%0%i%`L>!#%U%k%Q%9$G=q$/!#(B" )
  52.  
  53. (defvar skk-server-jisyo (getenv "SKK_JISYO")
  54.   "*SKK $B<-=q%5!<%P!<%W%m%0%i%`$KEO$9<-=qL>!#%U%k%Q%9$G=q$/!#(B" )
  55.  
  56. (defvar skk-server-portnum nil
  57.   "*Non-nil $B$G$"$l$P!"$=$NCM$r(B port number $B$H$7$F(B skkserv $B$H(B TCP $B@\B3$9$k!#(B
  58. /etc/services $B$rD>@\=q$-49$($k8"8B$,$J$$%f!<%6!<$N$?$a$NJQ?t!#(B" )
  59.  
  60. ;;(defvar skk-server-debug nil
  61. ;;  "*Non-nil $B$G$"$l$P!"<-=q%5!<%P!<%W%m%0%i%`$r%G%#%P%C%0%b!<%I$G5/F0$9$k!#(B
  62. ;;$B%G%#%P%C%0!&%b!<%I$G(B skkserv $B$rAv$i$;$k$H!"$=$N$^$^(B foreground $B$GAv$j!"%a%C%;!<(B
  63. ;;$B%8$r=PNO$9$k!#%-!<%\!<%I$+$i3d$j$3$_$r$+$1$k$3$H$b$G$-$k!#(B" )
  64.  
  65. ;;;###skk-autoload
  66. (defvar skk-servers-list nil
  67.   "*$B<-=q%5!<%P!<Kh$N>pJs%j%9%H!#(B
  68. $BJ#?t$N%^%7!<%s$GF0$$$F$$$k%5!<%P$K%"%/%;%9$G$-$k>l9g$K$O!"0J2<$N$h$&$K!"%j%9%H(B
  69. $B$N3FMWAG$K=g$K%[%9%HL>!"%U%k%Q%9$G$N(B SKK $B%5!<%P!<L>!"(BSKK $B%5!<%P!<$KEO$9<-=qL>!"(B
  70. SKK $B%5!<%P!<$,;HMQ$9$k%]!<%HHV9f$r=q$-!"@_Dj$r$9$k$3$H$b$G$-$k!#(B
  71.  
  72.    (setq skk-servers-list
  73.          '((\"mars\" \"/usr/local/soft/nemacs/etc/skkserv\" nil nil)
  74.            (\"venus\" \"/usr/local/nemacs/etc/skkserv\" nil nil) ))
  75.  
  76. $B$3$N>l9g:G=i$K;XDj$7$?%5!<%P$K%"%/%;%9$G$-$J$/$J$k$H!"<+F0E*$K=g<!%j%9%H$K$"$k(B
  77. $B;D$j$N%5!<%P$K%"%/%;%9$9$k$h$&$K$J$k!#$J$*(B SKK $B%5!<%P!<$KEO$9<-=q$*$h$S(B SKK $B%5!<(B
  78. $B%P!<$,;HMQ$9$k%]!<%HHV9f$G!"(BSKK $B%5!<%P!<$r%3%s%Q%$%k;~$NCM$r;HMQ$9$k>l9g$O(B nil 
  79. $B$r;XDj$9$k!#(B" )
  80.  
  81. (defvar skk-report-server-response nil
  82.   "*Non-nil $B$G$"$l$P!"JQ49;~(B SKK $B%5!<%P!<$NAw=P$9$kJ8;z$r<u$1<h$k$^$G$K(B accept-process-output $B$r2?2s<B9T$7$?$+$rJs9p$9$k!#(B" )
  83.  
  84. (defvar skk-remote-shell-program
  85.   (or (getenv "REMOTESHELL")
  86.       (and (boundp 'remote-shell-program) remote-shell-program)
  87.       (cond
  88.        ((eq system-type 'berkeley-unix)
  89.         (if (file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh" "/usr/bin/rsh") )
  90.        ((eq system-type 'usg-unix-v)
  91.         (if (file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh" "/bin/rsh"))
  92.        ((eq system-type 'hpux) "/usr/bin/remsh")
  93.        ((eq system-type 'EWS-UX/V) "/usr/ucb/remsh")
  94.        ((eq system-type 'pcux) "/usr/bin/rcmd")
  95.        (t "rsh") ))
  96.   "*$B%j%b!<%H%7%'%k$N%W%m%0%i%`L>!#(B" )
  97.  
  98. (defvar skk-server-load-hook nil
  99.   "*skk-server.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
  100.  
  101. ;; internal variable.
  102. (defvar skk-network-open-status 'open
  103.   "" )
  104.  
  105. ;;;###skk-autoload
  106. (defun skk-server-version ()
  107.   (interactive)
  108.   (if (interactive-p)
  109.       (message (skk-server-version))
  110.     (let (status)
  111.       (if (not (or skk-server-host skk-servers-list))
  112.           (skk-error "Lack of host information of SKK server"
  113.                      "SKK $B%5!<%P!<$N%[%9%H>pJs$,$"$j$^$;$s(B" ))
  114.       (setq status (process-status "skkservd"))
  115.       (if (not (eq status skk-network-open-status))
  116.           (setq status (skk-open-server)) )
  117.       (if (eq status skk-network-open-status)
  118.           (let (v)
  119.             (save-match-data
  120.               (with-current-buffer " *skkserv*"
  121.                 (erase-buffer)
  122.                 ;; $B%5!<%P!<%P!<%8%g%s$rF@$k!#(B
  123.                 (process-send-string "skkservd" "2")
  124.                 (while (eq (buffer-size) 0)
  125.                   (accept-process-output) )
  126.                 (setq v (buffer-string))
  127.                 (erase-buffer)
  128.                 ;; $B%[%9%HL>$rF@$k!#(B
  129.                 (process-send-string "skkservd" "3")
  130.                 (while (eq (buffer-size) 0)
  131.                   (accept-process-output) )                  
  132.                 (goto-char (point-min))
  133.                 (format
  134.                  (concat "SKK SERVER version %s"
  135.                          (if skk-japanese-message-and-error
  136.                              "($B%[%9%HL>(B %s)"
  137.                            "running on HOST %s" ))
  138.                  v (prog1 (buffer-string) (erase-buffer)) ))))))))
  139.  
  140. (defun skk-search-server (file limit &optional nomsg)
  141.   ;; SKK $B<-=q%U%)!<%^%C%H$N(B FILE $B$G(B SKK $B%5!<%P!<$r;HMQ$7$F(B skk-henkan-key $B$r%-!<(B
  142.   ;; $B$K$7$F8!:w$r9T$&!#(B
  143.   ;; SKK $B%5!<%P!<$,;HMQ$G$-$J$$$H$-$O!"(BFILE $B$r%P%C%U%!$KFI$_9~$s$G%5!<%A$r9T(B
  144.   ;; $B$&!#(B
  145.   ;; LIMIT $B$H(B NOMSG $B$O(B SKK $B%5!<%P!<$r;HMQ$7$J$$$H$-$N$_;H$&!#(B
  146.   ;; $B8!:w%j!<%8%g%s$,(B LIMIT $B0J2<$K$J$k$^$G%P%$%J%j%5!<%A$r9T$$!"$=$N8e%j%K%"(B
  147.   ;; $B%5!<%A$r9T$&!#(B
  148.   ;; LIMIT $B$,(B 0 $B$G$"$l$P!"%j%K%"%5!<%A$N$_$r9T$&!#(B
  149.   ;; $B<-=q$,%=!<%H$5$l$F$$$J$$$N$G$"$l$P!"(BLIMIT $B$r(B 0 $B$9$kI,MW$,$"$k!#(B
  150.   ;; $B%*%W%7%g%J%k0z?t$N(B NOMSG $B$,(B non-nil $B$G$"$l$P(B skk-get-jisyo-buffer $B$N%a%C(B
  151.   ;; $B%;!<%8$r=PNO$7$J$$$h$&$K$9$k!#(B
  152.   (if (or skk-server-host skk-servers-list)
  153.       (skk-search-server-subr file limit)
  154.     (skk-search-jisyo-file file limit nomsg) ))
  155.  
  156. (defun skk-search-server-subr (file limit)
  157.   ;; skk-search-server $B$N%5%V%k!<%A%s!#(B
  158.   (let ((key
  159.      (if skk-use-numeric-conversion
  160.          (skk-compute-numeric-henkan-key skk-henkan-key)
  161.        skk-henkan-key))
  162.         ;; $B%P%C%U%!%m!<%+%kCM$N<u$1EO$7$N$?$a!"JLL>$N0l;~JQ?t$K<h$k!#(B
  163.         (okurigana (or skk-henkan-okurigana skk-okuri-char))
  164.         (status (process-status "skkservd")) )
  165.     (if (or (not status) (not (eq status skk-network-open-status)))
  166.         (setq status (skk-open-server)) )
  167.     (if (eq status skk-network-open-status)
  168.         (with-current-buffer " *skkserv*"
  169.           (let ((cont t) (count 0)
  170.                 l )
  171.             (erase-buffer)
  172.             (process-send-string "skkservd" (concat "1" key " "))
  173.             (while (and cont (eq (process-status "skkservd")
  174.                                  skk-network-open-status ))
  175.               (accept-process-output)
  176.               (setq count (1+ count))
  177.               (if (> (buffer-size) 0)
  178.                   (if (eq  (char-after 1) ?1) ;?1
  179.                       ;; found key successfully, so check if a whole line
  180.                       ;; is received.
  181.                       (if (eq (char-after (1- (point-max))) ?\n) ;?\n
  182.                           (setq cont nil) )
  183.                     ;; not found or error, so exit
  184.                     (setq cont nil) )))
  185.             (goto-char (point-min))
  186.             (if skk-report-server-response
  187.                 (skk-message "%d $B2s(B SKK $B%5!<%P!<$N1~EzBT$A$r$7$^$7$?(B"
  188.                              "Waited for server response %d times" count ))
  189.             (if (eq (following-char) ?1) ;?1
  190.                 (progn
  191.                   (forward-char 2)
  192.                   (setq l (skk-compute-henkan-lists okurigana))
  193.                   (if l
  194.                       (cond ((and okurigana skk-henkan-okuri-strictly)
  195.                  ;; $BAw$j2>L>$,F10l$N%(%s%H%j$N$_$rJV$9!#(B
  196.                  (nth 2 l) )
  197.                 ((and okurigana skk-henkan-strict-okuri-precedence)
  198.                  (skk-nunion (nth 2 l) (car l)) )
  199.                 (t (car l)) ))))))
  200.       ;; server is not active, so search file instead
  201.       (skk-search-jisyo-file file limit) )))
  202.  
  203. (defun skk-open-server ()
  204.   ;; SKK $B%5!<%P!<$H@\B3$9$k!#%5!<%P!<%W%m%;%9$N(B status $B$rJV$9!#(B
  205.   (let (status code)
  206.     (if (or (skk-open-network-stream) (skk-open-server-1))
  207.         (progn
  208.           (setq status (process-status "skkservd"))
  209.           (if (eq status skk-network-open-status)
  210.               (progn
  211.                 (setq code (cdr (assoc "euc" skk-coding-system-alist)))
  212.         (if skk-xemacs
  213.             (let ((proc (get-process "skkservd")))
  214.               (set-process-input-coding-system proc code)
  215.               (set-process-output-coding-system proc code))
  216.           (if skk-mule
  217.               (set-process-coding-system (get-process "skkservd")
  218.                          code code )))))))
  219.     status ))
  220.  
  221. (defun skk-open-server-1 ()
  222.   ;; skk-open-server $B$N%5%V%k!<%A%s!#(B
  223.   ;; skkserv $B%5!<%S%9$r%*!<%W%s$G$-$?$i(B t $B$rJV$9!#(B
  224.   (let (status)
  225.     (if (null skk-servers-list)
  226.         (progn
  227.           ;; Emacs $B5/F08e$K4D6-JQ?t$r@_Dj$7$?>l9g!#(B
  228.           (if (not skk-server-host)
  229.               (setq skk-server-host (getenv "SKKSERVER")) )
  230.           (if (not skk-server-prog)
  231.               (setq skk-server-prog (getenv "SKKSERV")) )
  232.           (if (not skk-server-jisyo)
  233.               (setq skk-server-jisyo (getenv "SKK_JISYO")) )
  234.           (if (and skk-server-host skk-server-prog
  235.                    ;; skkserv $B$O0z?t$K<-=q$,;XDj$5$l$F$$$J$1$l$P!"(B
  236.                    ;; DEFAULT_JISYO $B$r;2>H$9$k!#(B
  237.                    ;;skk-server-jisyo
  238.                    )
  239.               (setq skk-servers-list (list (list skk-server-host
  240.                                                  skk-server-prog
  241.                                                  skk-server-jisyo
  242.                                                  skk-server-portnum )))
  243.             ;; reset SKK-SERVER-HOST so as not to use server in this session
  244.             (setq skk-server-host nil
  245.                   skk-server-prog nil ))))
  246.     (while (and (not (eq (process-status "skkservd") skk-network-open-status))
  247.                 skk-servers-list )
  248.       (let ((elt (car skk-servers-list))
  249.             arg )
  250.         (setq skk-server-host (car elt)
  251.               skk-server-prog (nth 1 elt)
  252.               skk-server-jisyo (nth 2 elt)
  253.               skk-server-portnum (nth 3 elt)
  254.               skk-servers-list (cdr skk-servers-list) )
  255.         ;; skkserv $B$N5/F0%*%W%7%g%s$O2<5-$NDL$j!#(B
  256.         ;;     skkserv [-d] [-p NNNN] [JISHO]
  257.         ;;     `-d'     $B%G%#%P%C%0!&%b!<%I(B
  258.         ;;     `-p NNNN'     $BDL?.MQ$N%]!<%HHV9f$H$7$F(BNNNN$B$r;H$&(B.
  259.         ;;     `~/JISYO'     ~/JISYO$B$r<-=q$H$7$FMxMQ(B.
  260.         (if skk-server-jisyo
  261.             (setq arg (list skk-server-jisyo))
  262.           ;; skkserv $B$O0z?t$K<-=q$,;XDj$5$l$F$$$J$1$l$P!"(BDEFAULT_JISYO $B$r(B
  263.           ;; $B;2>H$9$k!#(B
  264.           )
  265.         ;;(if skk-server-debug
  266.         ;;    (setq arg (cons "-d" arg)) )
  267.     (if (and skk-server-portnum (not (eq skk-server-portnum 1178)))
  268.         (setq arg
  269.           (nconc (list "-p" (int-to-string skk-server-portnum)) arg)))
  270.         (or (skk-open-network-stream)
  271.             (skk-startup-server arg) )))
  272.     (if (not (eq (process-status "skkservd") skk-network-open-status))
  273.         ;; reset SKK-SERVER-HOST so as not to use server in this session
  274.         (setq skk-server-host nil
  275.               skk-server-prog nil
  276.               skk-servers-list nil )
  277.       t )))
  278.  
  279. (defun skk-open-network-stream ()
  280.   ;; skk-server-host $B$K$*$1$k(B skkserv $B%5!<%S%9$N(B TCP $B@\B3$r%*!<%W%s$7!"%W%m%;(B
  281.   ;; $B%9$rJV$9!#(B
  282.   ;; open-network-stream $B$GB8:_$7$J$$%P%C%U%!$,;XDj$5$l$?$i!"(Bget-buffer-create
  283.   ;; $B$7$F$/$F$k$N$G!"ITMW!#(B
  284.   ;;(get-buffer-create " *skkserv*")
  285.   (condition-case nil
  286.       (open-network-stream
  287.        "skkservd" " *skkserv*" skk-server-host (or skk-server-portnum "skkserv"))
  288.     (error nil) ))
  289.  
  290. (defun skk-startup-server (arg)
  291.   ;; skkserv $B$r5/F0$G$-$?$i(B t $B$rJV$9!#(B
  292.   (let (
  293.         ;;(msgbuff (get-buffer-create " *skkserv-msg*"))
  294.         (count 7) status )
  295.     (while (> count 0)
  296.       (skk-message
  297.        "%s $B$N(B SKK $B%5!<%P!<$,5/F0$7$F$$$^$;$s!#5/F0$7$^$9(B%s"
  298.        "SKK SERVER on %s is not active, I will activate it%s"
  299.        skk-server-host (make-string count ?.) )
  300.       (if (or (string= skk-server-host (system-name))
  301.               (string= skk-server-host "localhost"))
  302.           ;; server host is local machine
  303.           (apply 'call-process skk-server-prog nil
  304.                  ;;msgbuff
  305.                  0 nil arg)
  306.         (apply 'call-process
  307.                skk-remote-shell-program nil
  308.                ;; 0 $B$K$7$F%5%V%W%m%;%9$N=*N;$rBT$C$F$O$$$1$J$$M}M3$,$"$k!)(B
  309.                ;; $B$J$1$l$P(B msgbuf $B$K%(%i!<=PNO$r<h$C$?J}$,7z@_E*$G$O!)(B  $B$^$?$=(B
  310.                ;; $B$N>l9g$O$3$N(B while $B%k!<%W<+?H$,$$$i$J$$!)(B
  311.                ;; msgbuff
  312.                0 nil skk-server-host skk-server-prog arg ))
  313.       (sit-for 3)
  314.       (if (and (skk-open-network-stream)
  315.                (eq (process-status "skkservd") skk-network-open-status) )
  316.           (setq count 0)
  317.         (setq count (1- count)) ))
  318.     (if (eq (process-status "skkservd") skk-network-open-status)
  319.         (progn
  320.           (skk-message "$B%[%9%H(B %s $B$N(B SKK $B%5!<%P!<$,5/F0$7$^$7$?(B"
  321.                        "SKK SERVER on %s is active now"
  322.                        skk-server-host )
  323.           (sit-for 1) ; return t
  324.           t ) ; $B$G$bG0$N$?$a(B
  325.       (skk-message "%s $B$N(B SKK $B%5!<%P!<$r5/F0$9$k$3$H$,$G$-$^$;$s$G$7$?(B"
  326.                    "Could not activate SKK SERVER on %s"
  327.                    skk-server-host )
  328.       (sit-for 1)
  329.       (ding) ;return nil
  330.       nil ))) ; $B$G$bG0$N$?$a(B
  331.  
  332. ;;;###skk-autoload
  333. (defun skk-adjust-search-prog-list-for-server-search (&optional non-del)
  334.   ;; skk-server-host $B$b$7$/$O(B skk-servers-list $B$,(B nil $B$G$"$l$P!"(B
  335.   ;; skk-search-prog-list $B$+$i(B skk-search-server $B$r(B car $B$K;}$D%j%9%H$r>C$9!#(B
  336.   ;; non-nil $B$G$"$l$P!"2C$($k!#(B
  337.   (if (or skk-server-host skk-servers-list)
  338.       (if (null (assq 'skk-search-server skk-search-prog-list))
  339.           ;; skk-search-prog-list $B$,(B nil $B$H$$$&$3$H$O$^$:$J$$$@$m$&$,!"G0$N$?(B
  340.           ;; $B$a!"(Bsetq $B$7$F$*$/!#(B          
  341.           (setq skk-search-prog-list
  342.                 ;; $BKvHx$KIU$1$k!#KvHx$K$O(B (skk-okuri-search) $B$r;}$C$F$-$?$$?M(B
  343.                 ;; $B$b$$$k$+$b!#%*%W%7%g%s$GIU$1$k>l=j$rJQ99$9$k$h$&$K$7$?J}$,(B
  344.                 ;; $BNI$$!)(B
  345.                 (nconc skk-search-prog-list
  346.                        (list
  347.                         '(skk-search-server skk-aux-large-jisyo 10000) ))))
  348.     (if (not non-del)
  349.         ;; skk-search-prog-list $B$N@hF,$,(B skk-search-server $B$+$i;O$^$k%j%9%H$@(B
  350.         ;; $B$H$$$&$3$H$O$^$:$J$$$@$m$&$,!"G0$N$?$a!"(Bsetq $B$7$F$*$/!#(B
  351.         (setq skk-search-prog-list
  352.               (delq (assq 'skk-search-server skk-search-prog-list)
  353.                     skk-search-prog-list )))))
  354.  
  355. (defun skk-disconnect-server ()
  356.   ;; $B%5!<%P!<$r@Z$jN%$9!#(B
  357.   (if (and skk-server-host
  358.            (eq (process-status "skkservd") skk-network-open-status) )
  359.       (progn
  360.         (process-send-string "skkservd" "0") ; disconnect server
  361.         (accept-process-output (get-process "skkservd")) )))
  362.  
  363. ;;(add-hook 'skk-mode-hook 'skk-adjust-search-prog-list-for-server-search)
  364. (add-hook 'skk-before-kill-emacs-hook 'skk-disconnect-server)
  365.  
  366. (run-hooks 'skk-server-load-hook)
  367.  
  368. (provide 'skk-server)
  369. ;;; skk-server.el ends here
  370.